home *** CD-ROM | disk | FTP | other *** search
/ X User Tools / X User Tools (O'Reilly and Associates)(1994).ISO / sun4c / archive / tcltk.z / tcltk / slib / tk / demos / rolodex < prev    next >
Text File  |  1994-09-20  |  11KB  |  264 lines

  1. #!///////////////////////////////////////////////////////////////////////////usr/STAGE/bin/wish -f
  2. #
  3. # This script was written as an entry in Tom LaStrange's rolodex
  4. # benchmark.  It creates something that has some of the look and
  5. # feel of a rolodex program, although it's lifeless and doesn't
  6. # actually do the rolodex application.
  7.  
  8. foreach i [winfo child .] {
  9.     catch {destroy $i}
  10. }
  11.  
  12. proc tkerror err {
  13.     global errorInfo
  14.     puts stdout "$errorInfo"
  15. }
  16.  
  17. #------------------------------------------
  18. # Phase 0: create the front end.
  19. #------------------------------------------
  20.  
  21. frame .frame -relief flat
  22. pack .frame -side top -fill y -anchor center
  23.  
  24. set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:}
  25. foreach i {1 2 3 4 5 6 7} {
  26.     frame .frame.$i
  27.     pack .frame.$i -side top -pady 2 -anchor e
  28.  
  29.     label .frame.$i.label -text [lindex $names $i] -anchor e
  30.     entry .frame.$i.entry -width 30 -relief sunken
  31.     pack .frame.$i.entry .frame.$i.label -side right
  32. }
  33.  
  34. frame .buttons
  35. pack .buttons -side bottom -pady 2 -anchor center
  36. button .buttons.clear -text Clear
  37. button .buttons.add -text Add
  38. button .buttons.search -text Search
  39. button .buttons.delete -text "Delete ..."
  40. pack .buttons.clear .buttons.add .buttons.search .buttons.delete \
  41.     -side left -padx 2
  42.  
  43. #------------------------------------------
  44. # Phase 1: Add menus, dialog boxes
  45. #------------------------------------------
  46.  
  47. frame .menu -relief raised -borderwidth 1
  48. pack .menu -before .frame -side top -fill x
  49.  
  50. menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
  51. menu .menu.file.m
  52. .menu.file.m add command -label "Load ..." -command fileAction -underline 0
  53. .menu.file.m add command -label "Exit" -command {destroy .} -underline 0
  54. pack .menu.file -side left
  55.  
  56. menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
  57. menu .menu.help.m
  58. pack .menu.help -side right
  59.  
  60. tk_menuBar .menu .menu.file .menu.help
  61. tk_bindForTraversal .
  62.  
  63. # The mkDialog procedure below was pirated from the widget demo.  It
  64. # was not written fresh for this benchmark.
  65.  
  66. # Create a dialog box.  Takes three or more arguments.  The first is
  67. # the name of the window to use for the dialog box.  The second is a set
  68. # of arguments for use in creating the message of the dialog box.  The
  69. # third and following arguments consist of two-element lists, each
  70. # describing one button.  The first element gives the text to be displayed
  71. # in the button, the second gives the command to be invoked when the
  72. # button is invoked.
  73.  
  74. proc mkDialog {w msgArgs args} {
  75.     catch {destroy $w}
  76.     toplevel $w -class Dialog
  77.     set oldFocus [focus]
  78.  
  79.     # Create two frames in the main window. The top frame will hold the
  80.     # message and the bottom one will hold the buttons.  Arrange them
  81.     # one above the other, with any extra vertical space split between
  82.     # them.
  83.  
  84.     frame $w.top -relief raised -border 1
  85.     frame $w.bot -relief raised -border 1
  86.     pack $w.top $w.bot -side top -fill both -expand yes
  87.  
  88.     # Create the message widget and arrange for it to be centered in the
  89.     # top frame.
  90.     
  91.     eval message $w.top.msg -justify center \
  92.         -font -Adobe-times-medium-r-normal--*-180* $msgArgs
  93.     pack $w.top.msg -side top -expand yes -padx 2 -pady 2
  94.  
  95.     # Create as many buttons as needed and arrange them from left to right
  96.     # in the bottom frame.  Embed the left button in an additional sunken
  97.     # frame to indicate that it is the default button, and arrange for that
  98.     # button to be invoked as the default action for clicks and returns in
  99.     # the dialog.
  100.  
  101.     if {[llength $args] > 0} {
  102.     set arg [lindex $args 0]
  103.     frame $w.bot.0 -relief sunken -border 1
  104.     pack $w.bot.0 -side left -expand yes -padx 10 -pady 10
  105.     button $w.bot.0.button -text [lindex $arg 0] \
  106.         -command "[lindex $arg 1]; destroy $w; focus $oldFocus"
  107.     pack $w.bot.0.button -expand yes -padx 6 -pady 6
  108.     bind $w.top <Enter> "$w.bot.0.button activate"
  109.     bind $w.top.msg <Enter> "$w.bot.0.button activate"
  110.     bind $w.bot <Enter> "$w.bot.0.button activate"
  111.     bind $w.top <Leave> "$w.bot.0.button deactivate"
  112.     bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
  113.     bind $w.bot <Leave> "$w.bot.0.button deactivate"
  114.     bind $w <1> "$w.bot.0.button config -relief sunken"
  115.     bind $w <ButtonRelease-1> \
  116.         "[lindex $arg 1]; $w.bot.0.button deactivate; destroy $w; focus $oldFocus"
  117.     bind $w <Return> "[lindex $arg 1]; destroy $w; focus $oldFocus"
  118.     focus $w
  119.  
  120.     set i 1
  121.     foreach arg [lrange $args 1 end] {
  122.         button $w.bot.$i -text [lindex $arg 0] \
  123.             -command "[lindex $arg 1]; destroy $w; focus $oldFocus"
  124.         pack $w.bot.$i -side left -expand yes -padx 10
  125.         set i [expr $i+1]
  126.     }
  127.     }
  128.     wm geometry $w +300+350
  129. }
  130.  
  131. proc deleteAction {} {
  132.     mkDialog .delete {-text "Are you sure?" -aspect 10000} \
  133.         "OK clearAction" "Cancel {}"
  134. }
  135. .buttons.delete config -command deleteAction
  136.  
  137. proc fileAction {} {
  138.     mkDialog .fileSelection {-text "This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet." -aspect 400} "OK {puts stderr {dummy file name}}"
  139. }
  140.  
  141. #------------------------------------------
  142. # Phase 3: Print contents of card
  143. #------------------------------------------
  144.  
  145. proc addAction {} {
  146.     global names
  147.     foreach i {1 2 3 4 5 6 7} {
  148.     puts stderr [format "%-12s %s" [lindex $names $i] [.frame.$i.entry get]]
  149.     }
  150. }
  151. .buttons.add config -command addAction
  152.  
  153. #------------------------------------------
  154. # Phase 4: Miscellaneous other actions
  155. #------------------------------------------
  156.  
  157. proc clearAction {} {
  158.     foreach i {1 2 3 4 5 6 7} {
  159.     .frame.$i.entry delete 0 end
  160.     }
  161. }
  162. .buttons.clear config -command clearAction
  163.  
  164. proc fillCard {} {
  165.     clearAction
  166.     .frame.1.entry insert 0 "John Ousterhout"
  167.     .frame.2.entry insert 0 "CS Division, Department of EECS"
  168.     .frame.3.entry insert 0 "University of California"
  169.     .frame.4.entry insert 0 "Berkeley, CA 94720"
  170.     .frame.5.entry insert 0 "private"
  171.     .frame.6.entry insert 0 "510-642-0865"
  172.     .frame.7.entry insert 0 "510-642-5775"
  173. }
  174. .buttons.search config -command "addAction; fillCard"
  175.  
  176. #----------------------------------------------------
  177. # Phase 5: Accelerators, mnemonics, command-line info
  178. #----------------------------------------------------
  179.  
  180. .buttons.clear config -text "Clear    Ctrl+C"
  181. bind Entry <Control-c> clearAction
  182. .buttons.add config -text "Add    Ctrl+A"
  183. bind Entry <Control-a> addAction
  184. .buttons.search config -text "Search    Ctrl+S"
  185. bind Entry <Control-s> "addAction; fillCard"
  186. .buttons.delete config -text "Delete...    Ctrl+D"
  187. bind Entry <Control-d> deleteAction
  188.  
  189. .menu.file.m entryconfig 0 -accel Ctrl+F
  190. bind Entry <Control-f> fileAction
  191. .menu.file.m entryconfig 1 -accel Ctrl+Q
  192. bind Entry <Control-q> {destroy .}
  193.  
  194. focus .frame.1.entry
  195.  
  196. #----------------------------------------------------
  197. # Phase 6: help
  198. #----------------------------------------------------
  199.  
  200. proc Help {topic {x 0} {y 0}} {
  201.     global helpTopics helpCmds
  202.     if {$topic == ""} return
  203.     while {[info exists helpCmds($topic)]} {
  204.     set topic [eval $helpCmds($topic)]
  205.     }
  206.     if [info exists helpTopics($topic)] {
  207.     set msg $helpTopics($topic)
  208.     } else {
  209.     set msg "Sorry, but no help is available for this topic"
  210.     }
  211.     mkDialog .help "-text {Information on $topic:\n\n$msg} -justify left -aspect 300" "OK {}"
  212. }
  213.  
  214. proc getMenuTopic {w x y} {
  215.     return $w.[$w index @[expr $y-[winfo rooty $w]]]
  216. }
  217.  
  218. bind Entry <Any-F1> {Help [winfo containing %X %Y] %X %Y}
  219. bind Entry <Any-Help> {Help [winfo containing %X %Y] %X %Y}
  220.  
  221. # Help text and commands follow:
  222.  
  223. set helpTopics(.menu.file) {This is the "file" menu.  It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.}
  224.  
  225. set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
  226. set helpTopics(.menu.file.m.0) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file}
  227. set helpTopics(.menu.file.m.1) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
  228. set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
  229.  
  230. set helpTopics(.frame.1.entry) {In this field of the rolodex entry you should type the person's name}
  231. set helpTopics(.frame.2.entry) {In this field of the rolodex entry you should type the first line of the person's address}
  232. set helpTopics(.frame.3.entry) {In this field of the rolodex entry you should type the second line of the person's address}
  233. set helpTopics(.frame.4.entry) {In this field of the rolodex entry you should type the third line of the person's address}
  234. set helpTopics(.frame.5.entry) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized}
  235. set helpTopics(.frame.6.entry) {In this field of the rolodex entry you should type the person's work phone number}
  236. set helpTopics(.frame.7.entry) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
  237.  
  238. set helpCmds(.frame.1.label) {set topic .frame.1.entry}
  239. set helpCmds(.frame.2.label) {set topic .frame.2.entry}
  240. set helpCmds(.frame.3.label) {set topic .frame.3.entry}
  241. set helpCmds(.frame.4.label) {set topic .frame.4.entry}
  242. set helpCmds(.frame.5.label) {set topic .frame.5.entry}
  243. set helpCmds(.frame.6.label) {set topic .frame.6.entry}
  244. set helpCmds(.frame.7.label) {set topic .frame.7.entry}
  245.  
  246. set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help.  Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys.  You can do this anytime.}
  247. set helpTopics(help) {This application provides only very crude help.  Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.}
  248. set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark.  It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.}
  249. set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)"
  250. set helpTopics(version) {This is version 1.0.}
  251.  
  252. # Entries in "Help" menu
  253.  
  254. .menu.help.m add command -label "On Context..." -command {Help context} \
  255.     -underline 3
  256. .menu.help.m add command -label "On Help..." -command {Help help} \
  257.     -underline 3
  258. .menu.help.m add command -label "On Window..." -command {Help window} \
  259.     -underline 3
  260. .menu.help.m add command -label "On Keys..." -command {Help keys} \
  261.     -underline 3
  262. .menu.help.m add command -label "On Version..." -command {Help version}  \
  263.     -underline 3
  264.